Track-a-cohort: Figures

Background

Objective: Using shared resources via BDO github from BOR, include more interactive capabilities to certain graphs in form of Rmarkdown and/or shinyapp. See Track a cohort_WR_plots.docx for figures requested.

Current figures working on:

Figure 2. STARs survival - shiny and update data sourcing (NB/SI)
Figure 3a & 3b JPE loss (a) percent and b) count) (3b is Fig 4 on Track a cohort_WR_plots.docx)- minor improvements & update data sourcing
Figure 4 (Fig 3b on Track a cohort_WR_plots.docx) Winter-run Current & Historical Cumulative Salvage - highlight years compared to current year and update data sourcing
Figure 5 (fig 6 on Track a cohort_WR_plots.docx) Cumulative loss by type - streamline code and update data sourcing

Issues:

For all figures – confirm method used to assign month to plots based on wDay.
Update naming to improve accuracy
update data sources

Current figures

Figure 2.

STARS Delta Survival

Function code used to plot along with warning message

#function to plot wday or doy with WY or CY-- CY needs adjustment and either probability metric from STARS

# Function to convert day of the year to month label
# day_to_month <- function(x) {
#   date <- as.Date(paste(year(today()), x, 1, sep = "-"), format = "%Y-%j")
#   month(date, label = TRUE)
# }
# Function to convert DOY to month name
doy_to_month <- function(doy, year_type) {
  # Adjust the DOY based on the year type
  adjusted_doy <- if (year_type == "WY") {
    (doy + 273) %% 365 + 1
  } else {
    doy
  }
  # Convert the adjusted DOY to a date
  date <- as.Date(paste(2000, adjusted_doy), format = "%Y %j")
  # Return the month name
  return(format(date, "%b"))
}


#currently has reactive title and caption--removed for shiny, see app.r
fct_stars_survival_plot <- function(data, x_var, year, metric) {
  
  # Define y variable and ribbon variables based on metric
  y_var <- metric
  ymin_var <- paste0(metric, "L80")
  ymax_var <- paste0(metric, "U80")
  
        # Define title based on metric
  rct_title <- switch(metric,
                  surv = 'STARS model - Overall Survival',
                  idsurv = 'STARS model -Interior Delta Route-specific Survival Probability',
                  idRoute = 'STARS model - Interior Delta Route-specific Probability',
                  'STARS model - Survival')
  
    # Define title based on metric
  rct_caption <- switch(metric,
                  surv = "The solid line shows median survival of daily cohorts of winter run Chinook Salmon\n through the Delta from Knights Landing to Chipps Island for all routes combined.",
                  idsurv = "Route-specific survival of daily cohorts of winter run Chinook Salmon\nthrough the Delta from Knights Landing to Chipps Island.",
                  idRoute = "Proportion of daily cohorts of winter run Chinook Salmon\nthrough the Delta (Knights Landing to Chipps Island) using the Interior Delta route.")
  
          # Define title based on metric
  rct_x_var <- switch(x_var,
                  wDay =  'Month\n(Water Year: Oct-Dec of year [t-1], Jan-Sep of year [t])',
                  doy =  'Month\n(Calendar Year: Jan-Dec of year [t])')
  
   # Generate the labels for the x-axis
  labels <- sapply(seq(1, 365, by = 60), function(doy) doy_to_month(doy, year))
  
  
  
  # Plot
  p <- ggplot(data, aes_string(x = x_var, group = year)) +
    geom_line(aes_string(y = y_var)) +
    labs(x = rct_x_var,
         y = 'Probability',
         title = rct_title,
         subtitle = "Years of data : 2018 to 2024",
         #losing caption with plotly--see plotly annotation instead
         caption = rct_caption) +
    gghighlight(use_direct_label = FALSE) +
    facet_wrap(as.formula(paste0("~", year))) +
    geom_ribbon(aes_string(ymin = ymin_var, ymax = ymax_var), alpha = 0.5) +
    scale_x_continuous(breaks = seq(1, 365, by = 60), labels = labels) +
    # scale_x_continuous(breaks = seq(1, 365, by = 60), labels = day_to_month) +
    theme_minimal()

  p <- plotly::ggplotly(p)
  

p <- p %>%
  plotly::layout(
  autosize = F,
  margin = list(
    l = 50, # left margin
    r = 50, # right margin
    b = 100, # bottom margin
    t = 50, # top margin
    pad = 4 # padding
  )
  #annotation needs work -- if shiny or rmark easier to do outside plot
) %>% plotly::add_annotations(
  x = .65,
  y = -0.31,
  text = rct_caption,
  showarrow = F,
  xref = 'paper',
  yref = 'paper',
  xanchor = 'right',
  yanchor = 'auto',
  xshift = 0,
  yshift = 0,
  font = list(size = 10)
)
  
  return(p)
}

# Usage:
fct_stars_survival_plot(data = df_stars, x_var = "wDay", year = "WY", metric = "idRoute")

## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

fct_stars_survival_plot(data = df_stars, x_var = "wDay", year = "WY", metric = "idsurv")

fct_stars_survival_plot(data = df_stars, x_var = "wDay", year = "WY", metric = "surv")

Issues:

Nick shared code to get latest STARs output.
- To have real-time generated data for shiny, we’ll need to host in Linux server and have Susannah work her magic. Future update
- See app.R for basic shiny version
hoover label: best to just rename the datafile for geom_line() – using tooltip was not working. Look into how to drop gghighlight tooltip
update to using aes versus aes_string somehow and be able to plot x_var– see warning
plotly size

Figure 3. Juvenile Production Estimate Loss

Figure 3a. JPE percent loss

Figure 3b. JPE count loss

Issues: - Fig 3:

updating naming and source files (work with Susannah)
Fig3a :
- uses 02_HistoricWRSalvageandLoss.R - Nick Bertrund’s code
- JPE_Genetic_Loss_Comparison.csv where is this data sourced from? Why wouldn’t the genetic loss from url in import_loss_data match? OR why is an additional csv, WRgenetic.csv needed? Need one file and sum within– too many random files
Fig 3b:
- for fig3b, pull in winter for LAD or DNA, but then only plot LAD

Figure 4. Cumulative Salvage

Figure 4a. Current and Historical Cumulative Salvage

Figure 4a. Current and Historical Cumulative Salvage by season type and BiOp year

Black line represents all years above the current WY (2024) max cumulative loss and the brown/blue lines indicate dry and wet hydrological years, respectively. Dashed line represents the max cumulative loss in current water year: WY2024

Questions:

query from : https://www.cbr.washington.edu/sacramento/data/query_loss_detail.html with all years, species, and no LAD age restriction, but requires dna?
filters to include winter for LAD OR winter for DNA, which also filters to include only chinook
- could filter further to include only winter-run chinook for LAD and DNA diff or ~5700 to ~1700
for some reason, the url generated via query tool for all chinook, all years, and no LAD age restriction, but requires dna, does not return nearly as many records as the url generated by BOR. Will use theres for now– look into why.
Uses WYtype.csv – what is this data? Headers include: WY, Basin, Oct-Mar, Apr-Jul, WYsum, Index, Yr-type – Yr-type seems to be designating dry/wet year – where can this be sourced? This information will be hosted on SacPas updated website June 2024. The data is pulling from CDEC. Working with static file until I can update.

Figure 6. Cumulative loss by type with annual loss thresholds

https://www.cbr.washington.edu/sacramento/workgroups/salmon_monitoring.html#:~:text=Natural%20Winter%2DRun%20Chinook%20Salmon%20Loss